home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / text / misc / mk3d.lha / make3d / mk3d.e < prev    next >
Encoding:
Text File  |  1994-01-08  |  7.6 KB  |  322 lines
  1. MODULE 'dos/rdargs', 'dos/dostags', 'utility/tagitem', 'dos/dos'
  2.  
  3. ENUM OK,MEM,OPEN,READ,ARGS,CTRLC,ARG_IN=0,ARG_OUT,ARG_ERR,ARG_SIM,
  4.      ARG_MOO,ARG_MAX
  5.  
  6. RAISE MEM   IF List()=NIL,
  7.       MEM   IF String()=NIL,
  8.       OPEN  IF Open()=NIL,
  9.       ARGS  IF ReadArgs()=NIL,
  10.       "^C"  IF CtrlC()=TRUE
  11.  
  12. PROC randasc(easy)
  13. DEF test=0
  14.  SELECT easy
  15.   CASE 0
  16.    RETURN "A" + Rnd(26)
  17.   CASE 1
  18.    RETURN IF Rnd(100)>50 THEN "A" + Rnd(26) ELSE "a" + Rnd(26)
  19.   CASE 2
  20.    test:=Rnd(100)
  21.    IF test < 33 THEN RETURN "A" + Rnd(26)
  22.    IF test < 66 THEN RETURN "a" + Rnd(26)
  23.    RETURN "0" + Rnd(10)
  24.   CASE 4
  25.    RETURN Rnd(254)+1
  26.   DEFAULT
  27.    RETURN "!" + Rnd(92)
  28.  ENDSELECT
  29. ENDPROC
  30.  
  31.  
  32. PROC main() HANDLE
  33.  
  34.  DEF in=0,out=0,gramwidth=0,xdepth=0,col,pattern,stderr=0,arg_format,
  35.      patternbeg,patternend,buf,template,xtrahelp,myarg:PTR TO rdargs,
  36.      patterncur,indata,pat,n,p=0,del,mv,ins,rdarg:PTR TO rdargs,tmp,
  37.      args[ARG_MAX]:LIST,easy=3
  38.  myarg := pattern := indata := rdarg :=  stderr:= 0
  39.  template := 'IN=INPUT/A,OUT=OUTPUT,ERR=ERRORS/K,S=SIMPLE/N/K,MOO/S'
  40.  tmp:=Open('CONSOLE:',MODE_READWRITE)
  41.  xtrahelp := 'Usage: mk3d IN "filename" [OUT "filename"] [ERR "filename"]\n' +
  42.  '            [S "number"]\n\n' +
  43.  ' IN specifies a mandatory input file to read for a template.\n' +
  44.  'OUT specifies an optional output file to write.\n' +
  45.  'ERR specifies an optional error file to write (instead of stderr).\n' +
  46.  '  S specifies how simple the characters should be, by this chart:\n\n' +
  47.  '      0 = Only uppercase characters\n' +
  48.  '      1 = Upper/lowercase characters\n' +
  49.  '      2 = AlphaNumeric characters\n' +
  50.  '      3 = AlphaNumeric characters with symbols (default)\n' +
  51.  '     4+ = Anything from value 1 to 255\n\n' +
  52.  'For information about the IN file''s format, please, read mk3d.doc.\n' +
  53.  'NOTE: This program based on the same written for MS-DOS.\n' +
  54.  '      Modified somewhat heavily by Joseph E. Van Riper III\n' +
  55.  '      of the Cheese Olfactory Workshop.\n' 
  56.   
  57.  buf:=String(80)
  58.  
  59. /* Handle the arguments (somehow)
  60.  */
  61.  args[ARG_IN]:=0
  62.  args[ARG_OUT]:=0
  63.  args[ARG_ERR]:=0
  64.  args[ARG_SIM]:=3
  65.  args[ARG_MOO]:=0
  66.  myarg:=AllocDosObject(DOS_RDARGS, TAG_DONE)
  67.  myarg.exthelp := xtrahelp
  68.  arg_format:=template
  69.  rdarg:=ReadArgs(arg_format,args,myarg)
  70.  CtrlC()
  71.  
  72.  FOR del:=0 TO ARG_MAX-1
  73.   CtrlC()
  74.   SELECT del
  75.    CASE ARG_IN
  76.     IF args[ARG_IN]<>0
  77.      in := Open(args[ARG_IN], MODE_OLDFILE)
  78.      VfPrintf(tmp,'IN: \s\n',[args[ARG_IN]])
  79.     ELSE
  80.      Raise(ARGS)
  81.     ENDIF
  82.    CASE ARG_OUT
  83.     IF StrLen(args[ARG_OUT]) AND (args[ARG_OUT]<>0)
  84.      out := Open(args[ARG_OUT], MODE_NEWFILE)
  85.      VfPrintf(tmp,'OUT: \s\n',[args[ARG_OUT]])
  86.     ELSE
  87.      out := stdout
  88.     ENDIF
  89.    CASE ARG_ERR
  90.     IF StrLen(args[ARG_ERR]) AND (args[ARG_ERR]<>0)
  91.      VfPrintf(tmp,'ERR: \s\n',[args[ARG_ERR]])
  92.      stderr:=Open(args[ARG_ERR],MODE_NEWFILE)
  93.     ELSE
  94.      stderr:=Open('NIL:',MODE_NEWFILE)
  95.     ENDIF
  96.    CASE ARG_SIM
  97.     easy := args[ARG_SIM]
  98.    CASE ARG_MOO
  99.     IF args[ARG_MOO]
  100.      WriteF('\nCongrads.. you''re very observant!\n' +
  101.             'Unfortunately, all you get is a nice little:\n' +
  102.             'Mooooooooo.\n')
  103.      ENDIF
  104.    DEFAULT
  105.     Raise('$VER: mk3d 1.0 (8.1.94)')
  106.   ENDSELECT
  107.  ENDFOR
  108. /* READ IN GRAMWIDTH: STEREOGRAM WIDTH (INCLUDE 2*XDEPTH + FEW MORE)
  109.  */
  110.  
  111.  IF ReadStr(in, buf) = TRUE THEN Raise(READ)
  112.  gramwidth := Val(buf,NIL)
  113.  VfPrintf(stderr,'Gramwidth: \d\n',[gramwidth])
  114.  IF ( (gramwidth < 1) OR (gramwidth > 512) )
  115.   Raise("GRAM")
  116.  ENDIF
  117.  
  118.  /* READ IN XDEPTH: LENGTH OF REPEATING BG PATTERN
  119.   */
  120.  IF ReadStr(in, buf) = TRUE THEN Raise(READ)
  121.  xdepth := Val(buf,NIL)
  122.  VfPrintf(stderr,'Xdepth: \d\n',[xdepth])
  123.  IF ( (xdepth < 5) OR (xdepth > 64) OR ((xdepth*2) > gramwidth) )
  124.   Raise("XDEP")
  125.  ENDIF
  126.  
  127.  /* PRINT FUSION X'S
  128.   */
  129.  FOR col:=1 TO gramwidth-1
  130.   CtrlC()
  131.   FputC( out, IF Mod(col,xdepth) THEN " " ELSE "X" )
  132.  ENDFOR
  133.  FputC( out, 10 )
  134.  
  135.  
  136.  /* SEED RANDOM NUMBER GENERATOR (if desired)
  137.   */
  138.  
  139.  Rnd(-(VbeamPos()))
  140.  
  141.  pattern := List(xdepth+1)
  142.  indata := String(gramwidth+1)
  143.  
  144.  /* IF NOT EOF, GET A LINE OF DATA
  145.   */
  146.  WHILE (ReadStr(in,indata)<>-1)
  147.   /* GENERATE A NEW RANDOM PATTERN,
  148.    * OUTPUT FULL PATTERN TO START THE LINE
  149.    */
  150.   CtrlC()
  151.   FOR pat:=0 TO xdepth
  152.    CtrlC()
  153.    pattern[pat] := randasc(easy)
  154.    IF pat <> xdepth THEN FputC ( out, pattern[pat] )
  155.   ENDFOR
  156.  
  157.   /* N IS VALUE OF NEXT CHAR, P IS VALUE OF PREVIOUS CHAR
  158.    */
  159.  
  160.   patterncur := patternbeg := col := p := n := 0
  161.   patternend := xdepth
  162.  
  163.   /* WHILE NOT EOL
  164.    */
  165.   WHILE (col < (gramwidth-xdepth))
  166.    /* SET N TO VALUE OF NEXT CHAR
  167.     */
  168.    CtrlC()
  169.    IF ( (indata[col] >= "1") AND (indata[col] <= "9") )
  170.     n := indata[col] - "0"
  171.     VfPrintf(stderr,'\d',[n])
  172.    ELSE
  173.     n := 0
  174.     VfPrintf(stderr,' ',0)
  175.    ENDIF
  176.  
  177.    /* IF NEXT VALUE IS NOT THE SAME AS THE PREV VALUE (LEVEL SHIFT)
  178.     */
  179.    IF (n <> p)
  180.     /* IF SHIFTING 'UP' (CLOSER TO USER)
  181.      */
  182.     IF (n > p)
  183.      /* DEL NEXT N-P BITS IN PATTERN
  184.       */
  185.      FOR del := 0 TO (n-p-1)
  186.       CtrlC()
  187.       mv := patterncur
  188.       REPEAT
  189.        CtrlC()
  190.        pattern[mv]:=pattern[mv+1]
  191.        INC mv
  192.       UNTIL (mv=(patternend+1))
  193.       DEC patternend
  194.       IF (patterncur = patternend) THEN patterncur := patternbeg
  195.      ENDFOR
  196.     /* SHIFTING 'DOWN' (AWAY FROM USER)
  197.      */
  198.     ELSE
  199.      /* INSERT P-N RANDOM BITS INTO PATTERN
  200.       */
  201.      FOR ins := 0 TO (p-n-1)
  202.       CtrlC()
  203.       FOR mv:=patternend+2 TO patterncur+1 STEP -1
  204.        CtrlC()
  205.        pattern[mv]:=pattern[mv-1]
  206.       ENDFOR
  207.       pattern[patterncur]:=randasc(easy)
  208.       INC patternend
  209.      ENDFOR
  210.     ENDIF
  211.  
  212.     /* UPDATE P
  213.      */
  214.     p := n
  215.  
  216.     /* OUTPUT NEXT CHAR IN RANDOM PATTERN
  217.      */
  218.     FputC(out,pattern[patterncur])
  219.     
  220.    /* NEXT VALUE IS SAME AS PREVIOUS VALUE
  221.     */
  222.    ELSE
  223.     /* OUTPUT NEXT CHAR IN RANDOM PATTERN
  224.      */
  225.     FputC(out,pattern[patterncur])
  226.     
  227.    ENDIF
  228.   /* ADVANCE PATTERN PTR
  229.    */
  230.    INC patterncur
  231.    IF (patterncur = patternend) THEN patterncur := patternbeg
  232.  
  233.   /* ADVANCE INPUT PTR
  234.    */
  235.    INC col
  236.   ENDWHILE
  237.   /* END OF LINE: OUTPUT NEWLINE CHAR, CLEAN LINE BUFFER
  238.    */
  239.   Fputs(out,'\n')
  240.   Fputs(stderr,'\n')
  241.   FOR del:=0 TO gramwidth+1
  242.    indata[del]:=0
  243.   ENDFOR
  244.  ENDWHILE
  245.  
  246.  /* END OF FILE: DONE, CLOSE UP
  247.   */
  248.  Raise(0)
  249.  
  250. EXCEPT
  251.  
  252.  IF in THEN Close(in)
  253.  IF out AND (out<>stdout) THEN Close(out)
  254.  IF pattern THEN Dispose(pattern)
  255.  IF indata THEN Dispose(indata)
  256.  IF rdarg THEN FreeArgs(rdarg)
  257.  IF myarg THEN FreeDosObject(DOS_RDARGS,myarg)
  258.  IF stderr THEN Close(stderr)
  259.  stderr:=tmp
  260.  
  261.  p := 'something (maybe internal error).\n'
  262.  n := IoErr()
  263.  
  264.  SELECT exception
  265.  
  266.   CASE OK
  267.    p := 0
  268.   CASE OPEN
  269.    VfPrintf(stderr,'Cannot open ',0)
  270.    IF (in=NIL)
  271.     VfPrintf(stderr,'infile.\n',0)
  272.    ELSEIF (out=NIL)
  273.     VfPrintf(stderr,'outfile.\n',0)
  274.    ELSE
  275.     VfPrintf(stderr,p,0)
  276.    ENDIF
  277.    p := 10
  278.   CASE MEM
  279.    VfPrintf(stderr,'Unable to allocate memory for ',0)
  280.    IF (pattern=NIL)
  281.     VfPrintf(stderr,'pattern.\n',0)
  282.    ELSEIF (indata=NIL)
  283.     VfPrintf(stderr,'incoming data.\n',0)
  284.    ELSE
  285.     VfPrintf(stderr,p,0)
  286.    ENDIF
  287.    p := 20
  288.   CASE "GRAM"
  289.    VfPrintf(stderr,'Gramwidth value must be between 1 and 512.\n',0)
  290.    p := 10
  291.   CASE "XDEP"
  292.    VfPrintf(stderr,'Xdepth value must be between 5 and 64\n' +
  293.           '(and less than half the stereogram width).\n',0)
  294.    p := 10
  295.   CASE ARGS
  296.    VfPrintf(stderr,xtrahelp,0)
  297.    p := 5
  298.   CASE READ
  299.    VfPrintf(stderr,'Error while reading input file.\n',0)
  300.    p := 10
  301.   CASE "^C"
  302.    VfPrintf(stderr,'mk3d: ***Break\n',0)
  303.    n := 0
  304.    p := 20
  305.   DEFAULT
  306.    VfPrintf(stderr,'Extremely Awful Internal Error.  Mention following to author:\n',0)
  307.    VfPrintf(stderr,'\s\n',[exception])
  308.    p := 20
  309.  ENDSELECT
  310.  
  311.  SetIoErr(n)
  312.  buf:=String(100)
  313.  IF IoErr()
  314.   Fault(IoErr(),'mk3d',buf,100)
  315.   VfPrintf(stderr,buf,0)
  316.  ENDIF
  317.  VfPrintf(stderr,'\n',0)
  318.  IF stderr THEN Close(stderr)
  319.  CleanUp(p)
  320.  
  321. ENDPROC
  322.